﻿//----------------------------------------------------------------------------
// Copyright (c) Pavel Tishkin 2012-2013.
//
// You must not remove this notice, or any other, from this software.
//----------------------------------------------------------------------------

namespace Lib.Dxp.Core


module Html = 

    open System
    open System.Web
    open System.Runtime.CompilerServices
    open Lib.Dxp.Core.Text


    /// Block of Html Tree structure
    type HtmlTagEntryTag = private { 
        opening : string 
        closing : string 
        boding : HtmlTagEntry list 
        }


    and  HtmlTagEntry = 
        | E_TAG     of HtmlTagEntryTag
        | E_TEXT    of string
        | E_EVAL    of (unit -> string)
        | E_LOCALED of string
        with
            static member Empty with get() = E_TEXT ""

            /// Transform `strings` in safe view of TEXT. Unchanged if already `HtmlTagEntry`
            static member ToTagEntry(x : 'a) = 
                match box x with
                | :? string as x                -> x |> no_ltgtamp |> E_TEXT
                | :? HtmlTagEntry as x          -> x
                | :? (unit -> string)    as f   -> E_EVAL f                   //| :? System.Func<string> as f   -> EVAL (fun () -> f.Invoke())
                | _                             -> x |> no_ltgtamp |> E_TEXT

            /// Writes full `HtmlTagEntry` to `TextWriter`
            member x.ToStream(localizer : string -> string, stream : System.IO.TextWriter) = 
                    match x with
                    | E_TAG ({ opening = "" } as h)   -> h.boding |> Seq.iter (fun e -> e.ToStream (localizer, stream))
                    | E_TAG ({ boding = [] }  as h)   -> stream.Write( Fmt.Sformat.CLOSED_TAG h.opening )
                    | E_TAG  h -> 
                        stream.Write( Fmt.Sformat.STARTOF_TAG h.opening)
                        h.boding |> Seq.iter (fun e -> e.ToStream (localizer, stream))
                        stream.Write( Fmt.Sformat.ENDOF_TAG h.closing)
                    | E_TEXT t      -> stream.Write(t)
                    | E_EVAL f      -> stream.Write(f())
                    | E_LOCALED x   -> stream.Write(localizer x)

            member x.ToString(localizer : string -> string) = 
                let stream = new System.IO.StringWriter()
                x.ToStream (localizer, stream)
                stream.ToString()

            override x.ToString() = 
                let stream = new System.IO.StringWriter()
                x.ToStream (id, stream)
                stream.ToString()


    module ScriptCode =
        let [<Literal>] private Ajax_Marker         = "o();"

        let response (x : string)           = Ajax_Marker + x
        let alert (x : string)              = response  <| "alert('{0}')".format(x |> no_quotes |> no_nl |> no_tabs)
        let alert_unknown_cmd (x : string)  = alert <| "Unknown command `{0}`".format(x)
        let alert_exception (ex : exn)      = alert <| "EXCEPTION : {0}".format(ex.Message)
        let page_reload ()                  = response  <| "location.reload();"

        let apply_result _target = 
            let hcml = Ajax_Marker.Length
            sprintf @"if (data.substring(0, %i) == '%s') { eval(data.substr(%i)); } else { $('#%s').html(data); }; " 
                                                  hcml Ajax_Marker hcml  _target


    module Css =
        type Units = | Px of int | Perc of int | Pt of float | TextCssParam of string

        let inline private css (nm: string) (value : Units) = 
            match value with 
            | Px x           -> sprintf "%s: %ipx;" nm x 
            | Pt x           -> sprintf "%s: %.1fpt;" nm x 
            | Perc x         -> sprintf "%s: %i%c;" nm x '%'
            | TextCssParam x -> sprintf "%s: %s;" nm x 
        let fontsize n  = css "font-size" n
        let border view = css "border" (TextCssParam view)
        let smaller     = fontsize (Perc 80)
        let larger      = fontsize (Perc 120)
        let bold        = css "font-weight" (TextCssParam"bold")


    module Tag =
        let [<Literal>] private TREED_LEVELSPLIT = '|'
        let [<Literal>] private TREED_LOWERSPLIT = '`'

        let localed x = E_LOCALED (x)

        /// List of tags wrapped by tag from `openas` string
        let tag openas body = 
            E_TAG { opening = openas 
                    closing = if isNone openas then "" else trim <| openas.Split(' ').[0]
                    boding  = List.map HtmlTagEntry.ToTagEntry body }

        /// List of tags w/o wrapping parent tag
        let listOfTags body  = tag "" body

        /// One tag wrapped by other tag from `openas` string
        let tag1 openas e       = tag openas [e]

        //let plain s         = TEXT s


        module Attr = 
            let [<Literal>] W = "width"


        let attrtext (text : string) (h : HtmlTagEntry)  = 
            match h with
            | E_TAG  h -> E_TAG { h with opening = h.opening + " " + text }
            | h -> h

        let attr (key: string) (value: 'a)      = attrtext <| Fmt.String.HTML_ATTR.format(key, no_quotes value)
        let attrsafe (key: string) (value: 'a)  = attrtext <| Fmt.String.HTML_ATTR.format(key, no_ltgtamp value)
        let attrauto x                          = attr x x 

        let classid (clsid: 'a)             = attr "class" clsid
        let htmlid (id: 'a)                 = attr "id" id 
        let htmlname (nm: 'a)               = attr "name" nm
        let idname (idnm: 'a)               = attr "id" idnm >> attr "name" idnm 
        let style (styled: 'a)              = attrsafe "style" styled
        let styles (styled: Css.Units seq)  = attrsafe "style" ("".join styled)
        let typed (typename: 'a)            = attr "type" typename
        let valued (value: 'a)              = attr "value" value
        let src (uri: 'a)                   = attr "src" uri
        let colspan n                       = attr "colspan" n
        let rowspan n                       = attr "rowspan" n
        let noautocomplete x                = attr "autocomplete" "off" x

        let selected_if (cond : bool) h     = if cond then attrauto "selected" h else h
        let checked_if  (cond : bool) h     = if cond then attrauto "checked" h else h


        let private wrapperFn wrapersXs initData = wrapersXs |> List.fold (fun acc wr -> tag1 wr acc) initData

        /// wrappedByFormat (levelfmt : string) (data : HtmlTagEntry)
        let wrappedByFormat (levelfmt : string) (data : HtmlTagEntry) =
            match levelfmt.Split TREED_LEVELSPLIT |> Array.toList |> List.rev with
            | []        -> data
            | wrapersXs -> wrapperFn wrapersXs data


        /// treedByFormat (levelfmt : string) (datasplitter : char) (data : 'a) 
        let treedByFormat (levelfmt : string) (datasplitter : char) (data : 'a) =
            match levelfmt.Split TREED_LEVELSPLIT |> Array.toList |> List.rev with
            | iCell :: iRow :: wrapersXs ->
                let data_xs = data |> to_s |> splitBy datasplitter |> Array.toList
                let acc     = data_xs |> Seq.map (tag1 iCell) |> Seq.toList |> tag iRow
                wrapperFn wrapersXs acc
            | _ -> HtmlTagEntry.Empty

        /// tabledByFormat (levelfmt : string) (data : 'a seq seq)
        let tabledByFormat (levelfmt : string) (data : 'a seq seq) =
            match levelfmt.Split TREED_LEVELSPLIT |> Array.toList |> List.rev with
            | iCell :: iRow :: iTable :: wrapersXs ->
                let cell_fmt    = iCell |> splitBy TREED_LOWERSPLIT
                let fn_cell i   = tag1 cell_fmt.[i % cell_fmt.Length] 
                let acc = data |> Seq.map (Seq.mapi fn_cell >> Seq.toList >> tag iRow) 
                                |> Seq.toList
                wrapperFn wrapersXs (tag iTable acc)
            | _ -> HtmlTagEntry.Empty


        let nbsp                = E_TEXT "&nbsp;"
        let br                  = tag "br" []
        let hr                  = tag "hr" []

        let table  x            = tag "table" x
        let thead  x            = tag "thead" x
        let tbody  x            = tag "tbody" x
        let tfoot  x            = tag "tfoot" x
        let tr     x            = tag "tr"    x
        let td     x            = tag "td"    x
        let th     x            = tag "th"    x
        let div    x            = tag "div"   x
        let span   x            = tag "span"  x
        let script x            = tag "script" x
        let bold   x            = tag "strong" x
        let ul     x            = tag "ul"    x
        let li     x            = tag "li"    x

        let emptyTag            = E_TEXT ""
        
        /// img src' alt'  
        let img src' alt'       = tag "img" [] |> src src' 

        /// a   url' alt' xs
        let a   url' alt' xs    = tag "a" xs |> attr "href" url' |> (if isSome alt' then attr "title" alt' else id)

        /// act scriptaction alt' xs 
        let act url' alt' xs    = //a ("javascript:" + url') alt' xs
                                    tag "a" xs |> attrsafe "href" ("javascript:" + url') |> (if isSome alt' then attr "title" alt' else id)

        /// select id' defaultValue data
        let select id' defaultValue (data : ResizeArray<obj []>) =
            data |> Seq.map(fun e -> 
                                let value, text = e.[0], e.[1] 
                                tag1 "option" (no_quotes text)
                                |> valued value
                                |> selected_if (LanguagePrimitives.FastGenericEqualityComparer.Equals(value, defaultValue)) //|> selected_if (System.Collections.Generic.EqualityComparer.Default.Equals(value, defaultValue))
                                )
                    |> Seq.toList
                    |> (tag "select" >> idname id')
                    |> to_s

        /// input_text id' value    
        let input_text id' value        = tag "input" [] |> idname id' |> valued value |> typed "text" 
        /// input_hide id' value             
        let input_hide id' value        = tag "input" [] |> idname id' |> valued value |> typed "hidden"
        /// checkbox id' value           
        let checkbox id' value          = tag "input" [] |> idname id' |> valued value |> typed "checkbox" 
        /// button id' onclick childs
        let button id' onclick childs   = tag "button" childs |> htmlid id' |> attrsafe "onclick" onclick 

        let input id' value             = input_text id' value
        let text  id' value             = value |> no_ltgtamp |> tag1 "textarea" |> idname id' 




